home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp2.arc / PIBDIALB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-25  |  18.7 KB  |  558 lines
  1.  
  2. (*----------------------------------------------------------------------*)
  3. (*                  Dial_A_Number --- dial phone number                 *)
  4. (*----------------------------------------------------------------------*)
  5.  
  6. PROCEDURE Dial_A_Number(     Re_Dial : BOOLEAN;
  7.                          VAR Quit    : BOOLEAN );
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Procedure:  Dial_A_Number                                        *)
  12. (*                                                                      *)
  13. (*     Purpose:    Dials phone number                                   *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Dial_A_Number(     Re_Dial : BOOLEAN;                         *)
  18. (*                       VAR Quit    : BOOLEAN );                       *)
  19. (*                                                                      *)
  20. (*           Re_Dial --- TRUE to re-dial last number                    *)
  21. (*           Quit    --- TRUE if Esc key hit to stop dialing            *)
  22. (*                                                                      *)
  23. (*     Calls:   Async_Send_String                                       *)
  24. (*              Save_Screen                                             *)
  25. (*              Restore_Screen                                          *)
  26. (*              Draw_Menu_Frame                                         *)
  27. (*              Reset_Global_Colors                                     *)
  28. (*              Dialer_Carrier_Detect                                   *)
  29. (*              Display_Phone_Numbers                                   *)
  30. (*              TimeOfDay                                               *)
  31. (*              TimeDiff                                                *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. VAR
  36.    Dial_Title   : ShortStr;
  37.    OK_Redial    : BOOLEAN;
  38.    Ch           : CHAR;
  39.    Timed_Out    : BOOLEAN;
  40.    STimer       : REAL;
  41.    Modem_Mess   : AnyStr;
  42.    New_Baud     : INTEGER;
  43.    Ierr         : INTEGER;
  44.    Qerr         : BOOLEAN;
  45.    Snumber      : STRING[40];
  46.    Inumber      : INTEGER;
  47.    Modem_Buzy   : BOOLEAN;
  48.    Modem_NoC    : BOOLEAN;
  49.    T            : REAL;
  50.    TOD          : REAL;
  51.    IY           : INTEGER;
  52.    I            : INTEGER;
  53.    J            : INTEGER;
  54.    TS           : STRING[9];
  55.    TSO          : STRING[9];
  56.    ESC_Hit      : BOOLEAN;
  57.    Local_Save_3 : Saved_Screen_Ptr;
  58.    Local_Save_5 : Saved_Screen_Ptr;
  59.    Got_Num      : BOOLEAN;
  60.  
  61. BEGIN (* Dial_A_Number *)
  62.  
  63.    Modem_Mess  := '';
  64.    Manual_Dial := FALSE;
  65.    Quit        := FALSE;
  66.    Got_Num     := FALSE;
  67.  
  68.    OK_Redial := Re_Dial AND ( Phone_Number <> '' );
  69.  
  70.    IF OK_Redial THEN
  71.       Dial_Title := 'Redialing'
  72.    ELSE
  73.       Dial_Title := 'Dialing';
  74.  
  75.    Save_Screen( Local_Save_5 );
  76.  
  77.    IF NOT OK_Redial THEN
  78.       BEGIN  (* Not a redial *)
  79.  
  80.          Prefix_Str := '';
  81.                                    (* No dialing string given -- display *)
  82.                                    (* directory.                         *)
  83.  
  84.          IF LENGTH( Dialing_String ) = 0 THEN
  85.             BEGIN
  86.  
  87.                Display_Phone_Numbers( Phone_Number, Prefix_Str, Quit );
  88.  
  89.                IF Dialer_Carrier_Detect OR Quit OR
  90.                   ( LENGTH( Phone_Number ) = 0 ) THEN
  91.                   BEGIN
  92.                      Restore_Screen( Local_Save_5 );
  93.                      Reset_Global_Colors;
  94.                      EXIT;
  95.                   END
  96.                ELSE
  97.                   Got_Num := TRUE;
  98.  
  99.             END
  100.          ELSE                      (* Dialing string provided *)
  101.             BEGIN
  102.                Snumber := Dialing_String;
  103.                FOR I := 1 TO 25 DO
  104.                   Phone_Entry_Data.Phone_Name[I] := ' ';
  105.             END;
  106.  
  107.          IF ( NOT Quit ) THEN
  108.             BEGIN (* Phone number entered *)
  109.  
  110.                IF ( NOT Got_Num ) THEN
  111.                   BEGIN (* NOT Got_Num *)
  112.  
  113.                      IF UpCase( Snumber[1] ) = 'M' THEN
  114.                         BEGIN
  115.  
  116.                            Manual_Dial := TRUE;
  117.                            Snumber     := COPY( Snumber, 2,
  118.                                                 LENGTH( Snumber ) - 1 );
  119.  
  120.                            IF Snumber[1] IN ['+','-','!','@','#'] THEN
  121.                               BEGIN
  122.  
  123.                                  Prefix_Str := Phone_Prefix_Nos[ POS( Snumber[1],
  124.                                                                       '+-!@#' ) ];
  125.                                  Snumber    := COPY( Snumber, 2,
  126.                                                      LENGTH( Snumber ) - 1 );
  127.                               END;
  128.  
  129.                         END;
  130.  
  131.                      IF Manual_Dial THEN
  132.                         Phone_Number := Snumber
  133.                      ELSE
  134.                         BEGIN
  135.                            Inumber := 2;
  136.                            VAL( Snumber, Inumber, Ierr );
  137.                            IF ( Ierr = 0 ) THEN
  138.                               BEGIN
  139.                                  SEEK( Phone_File , Inumber - 1 );
  140.                                  READ( Phone_File , Phone_Entry_Data );
  141.                                  Phone_Number := Phone_Entry_Data.Phone_Number;
  142.                                  IF ( NOT Dialer_Carrier_Detect ) THEN
  143.                                     Reset_Comm_Params( Phone_Entry_Data );
  144.                               END
  145.                            ELSE
  146.                               BEGIN
  147.                                  WRITELN;
  148.                                  WRITE('Bad phone number, dialing cancelled.');
  149.                                  ClrEol;
  150.                                  DELAY( Two_Second_Delay );
  151.                               END;
  152.                         END;
  153.  
  154.                   END (* NOT Got_Num *);
  155.  
  156.             END (* Phone number entered *);
  157.  
  158.       END  (* Not a redial *);
  159.  
  160.    IF ( Dialer_Carrier_Detect AND ( NOT Quit ) ) THEN
  161.       BEGIN
  162.          Save_Screen( Local_Save_3 );
  163.          Window( 1, 1, 80, 25 );
  164.          Draw_Menu_Frame( 10, 5, 60, 8, Menu_Frame_Color,
  165.                           Menu_Text_Color + Blink, '' );
  166.          WRITE('Session already in progress, dialing aborted.');
  167.          DELAY( Two_Second_Delay );
  168.          Restore_Screen( Local_Save_3 );
  169.          Reset_Global_Colors;
  170.          Restore_Screen( Local_Save_5 );
  171.          Reset_Global_Colors;
  172.          EXIT;
  173.       END;
  174.  
  175.    IF ( LENGTH( Phone_Number ) > 0 ) AND ( NOT Quit ) THEN
  176.       BEGIN  (* Phone number gotten *)
  177.  
  178.          Window( 1, 1, 80, 25 );
  179.  
  180.          IF ( NOT Manual_Dial ) THEN
  181.             Dial_Title := TRIM( Dial_Title + ' ' +
  182.                                 Phone_Entry_Data.Phone_Name );
  183.  
  184.          Draw_Menu_Frame( 10, 10, 60, 16, Menu_Frame_Color,
  185.                           Menu_Text_Color, Dial_Title );
  186.  
  187.          GoToXY( 1 , 1 );
  188.                                    (* Purge receive to avoid *)
  189.                                    (* false modem messages   *)
  190.          Async_Purge_Buffer;
  191.  
  192.          IF OK_Redial THEN
  193.             WRITE('Re-dialing: ', Prefix_Str + Phone_Number )
  194.          ELSE
  195.             WRITE('Dialing: ', Prefix_Str + Phone_Number );
  196.  
  197.          ClrEol;
  198.  
  199.          Async_Send_String( Modem_Dial + Prefix_Str + Phone_Number +
  200.                             CHR( CR ) );
  201.  
  202.          STimer     := TimeOfDay;
  203.          Modem_Buzy := FALSE;
  204.          Modem_NoC  := FALSE;
  205.          IY         := WhereY;
  206.          TS         := '';
  207.  
  208.          GoToXY( 1 , 2 );
  209.          WRITE('Dialing begins at:    ',TimeString(TimeOfDay));
  210.          ClrEol;
  211.  
  212.          GoToXY( 1 , 3 );
  213.          WRITE('Elapsed dialing time: ');
  214.          ClrEol;
  215.  
  216.          REPEAT
  217.  
  218.             TOD       := TimeOfDay;
  219.             T         := TimeDiff( STimer , TOD );
  220.             TSO       := TS;
  221.             TS        := TimeString( T );
  222.  
  223.             IF TS <> TSO THEN
  224.                BEGIN
  225.                   GoToXY( 23 , 3 );
  226.                   WRITE( TS );
  227.                   ClrEol;
  228.                END;
  229.  
  230.             Timed_Out := ( T > Modem_Time_Out );
  231.  
  232.             IF Async_Receive( Ch ) THEN
  233.                Modem_Mess := Modem_Mess + Ch;
  234.  
  235.             Modem_Buzy := ( POS( Modem_Busy       , Modem_Mess ) > 0 ) AND
  236.                           ( LENGTH( Modem_Busy )  > 0 );
  237.             Modem_NoC  := ( POS( Modem_No_Carrier , Modem_Mess ) > 0 ) AND
  238.                           ( LENGTH( Modem_No_Carrier ) > 0 );
  239.  
  240.             Esc_Hit := FALSE;
  241.  
  242.             IF KeyPressed THEN
  243.                BEGIN
  244.  
  245.                   READ( Kbd, Ch );
  246.  
  247.                   IF Ch = CHR( ESC ) THEN
  248.                      Esc_Hit := TRUE;
  249.  
  250.                   WHILE( KeyPressed ) DO
  251.                      READ( Kbd, Ch );
  252.  
  253.                END;
  254.  
  255.          UNTIL ( Async_Carrier_Detect ) OR
  256.                ( Timed_Out            ) OR
  257.                ( Modem_Buzy           ) OR
  258.                ( Modem_NoC            ) OR
  259.                ( Esc_Hit              );
  260.  
  261.          IF Esc_Hit THEN
  262.             BEGIN
  263.  
  264.                GoToXY( 1 , WhereY );
  265.  
  266.                WRITE('*** ESC Pressed, Dialing Aborted.');
  267.                ClrEol;
  268.                                    (* Hang up the phone *)
  269.                HangUpPhone;
  270.  
  271.             END
  272.          ELSE IF Timed_Out THEN
  273.             BEGIN
  274.  
  275.                GoToXY( 1 , WhereY );
  276.                WRITE('*** Modem Timed Out, Dialing Aborted.');
  277.                ClrEol;
  278.  
  279.                DELAY( One_Second_Delay );
  280.  
  281.             END
  282.          ELSE IF Modem_Buzy THEN
  283.             BEGIN
  284.  
  285.                GoToXY( 1 , WhereY );
  286.  
  287.                WRITE('*** Line busy');
  288.                ClrEol;
  289.                                    (* Hang up the phone *)
  290.                HangUpPhone;
  291.  
  292.                DELAY( One_Second_Delay );
  293.  
  294.             END
  295.          ELSE IF Modem_NoC THEN
  296.             BEGIN
  297.  
  298.                GoToXY( 1 , WhereY );
  299.  
  300.                WRITE('*** No answer');
  301.                ClrEol;
  302.                                    (* Hang up the phone *)
  303.                HangUpPhone;
  304.  
  305.                DELAY( One_Second_Delay );
  306.  
  307.             END;
  308.  
  309.       END  (* Phone number gotten *);
  310.  
  311.    Restore_Screen( Local_Save_5 );
  312.    Reset_Global_Colors;
  313.  
  314.    IF ( Async_Carrier_Detect AND ( NOT Quit ) ) THEN
  315.       BEGIN  (* Carrier detected *)
  316.  
  317.          STimer     := TimeOfDay;
  318.  
  319.          REPEAT
  320.  
  321.             Timed_Out := TimeDiff( Stimer , TimeOfDay ) > 3.0;
  322.  
  323.             IF Async_Receive( Ch ) THEN
  324.                Modem_Mess := Modem_Mess + Ch;
  325.  
  326.          UNTIL( Ch = CHR( CR ) ) OR ( Timed_Out );
  327.  
  328.          IY     := 0;
  329.  
  330.          IF( LENGTH( Modem_Connect ) > 0 ) THEN
  331.             IY     := POS( Modem_Connect , Modem_Mess );
  332.  
  333.          IF ( IY > 0 ) THEN
  334.             BEGIN
  335.  
  336.                I        := IY + LENGTH( Modem_Connect ) + 1;
  337.                New_Baud := 0;
  338.  
  339.                FOR J := I TO LENGTH( Modem_Mess ) DO
  340.                   IF Modem_Mess[J] IN ['0'..'9'] THEN
  341.                      New_Baud := New_Baud * 10 + ORD( Modem_Mess[J] ) -
  342.                                                  ORD('0');
  343.  
  344.                IF ( New_Baud <> Baud_Rate ) AND
  345.                   ( New_Baud  > 0         )  THEN
  346.                   BEGIN
  347.                      Baud_Rate := New_Baud;
  348.                      Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
  349.                                        Data_Bits, Stop_Bits );
  350.                   END;
  351.  
  352.             END;
  353.  
  354.          WRITELN;
  355.          WRITELN('Connection established at ',Baud_Rate,',',Parity,',',
  356.                  Data_Bits,',',Stop_Bits);
  357.  
  358.       END (* Carrier detected *);
  359.  
  360.                                    (* Make sure phone hung up *)
  361.    IF Quit THEN
  362.       HangUpPhone;
  363.  
  364. END   (* Dial_A_Number *);
  365.  
  366. (*----------------------------------------------------------------------*)
  367. (*          Redial_A_Number --- Redial last phone number dialed         *)
  368. (*----------------------------------------------------------------------*)
  369.  
  370. PROCEDURE Redial_A_Number;
  371.  
  372. (*----------------------------------------------------------------------*)
  373. (*                                                                      *)
  374. (*     Procedure:  Redial_A_Number                                      *)
  375. (*                                                                      *)
  376. (*     Purpose:    Redials last number dialed (if any).                 *)
  377. (*                                                                      *)
  378. (*     Calling Sequence:                                                *)
  379. (*                                                                      *)
  380. (*        Redial_A_Number;                                              *)
  381. (*                                                                      *)
  382. (*     Calls:                                                           *)
  383. (*                                                                      *)
  384. (*        Dial_A_Number                                                 *)
  385. (*        TimeOfDay                                                     *)
  386. (*        TimeDiff                                                      *)
  387. (*        Dialer_Carrier_Detect                                         *)
  388. (*        Clear_Window                                                  *)
  389. (*                                                                      *)
  390. (*----------------------------------------------------------------------*)
  391.  
  392. VAR
  393.    RTimer       : REAL;
  394.    DTimer       : REAL;
  395.    PTimer       : REAL;
  396.    OTimer       : REAL;
  397.    Done         : BOOLEAN;
  398.    Rchar        : CHAR;
  399.    MDelay       : REAL;
  400.    MDnew        : REAL;
  401.    Ypos         : INTEGER;
  402.    Local_Save_5 : Saved_Screen_Ptr;
  403.    Quit         : BOOLEAN;
  404.  
  405. BEGIN (* Redial_A_Number *)
  406.                                    (* Only redial if no current session *)
  407.  
  408.    Done   := Dialer_Carrier_Detect OR ( Phone_Number = '' );
  409.  
  410.    MDelay := Modem_Redial_Delay;
  411.  
  412.    WHILE( NOT Done ) DO
  413.       BEGIN
  414.                                    (* Redial the number *)
  415.  
  416.          Dial_A_Number( TRUE , Quit );
  417.  
  418.                                    (* If connection established, done *)
  419.  
  420.          Done   := Async_Carrier_Detect;
  421.  
  422.                                    (* Otherwise, wait for specified   *)
  423.                                    (* modem delay                     *)
  424.          IF ( NOT Done ) THEN
  425.             BEGIN
  426.  
  427.                Save_Screen( Local_Save_5 );
  428.                Draw_Menu_Frame( 10, 10, 60, 16, Menu_Frame_Color,
  429.                                 Menu_Text_Color, 'Redialing' );
  430.  
  431.                RTimer := TimeOfDay;
  432.  
  433.                Clear_Window;
  434.  
  435.                Ypos := WhereY;
  436.  
  437.                WRITELN(' Seconds to next redial: ', TRUNC( MDelay ) );
  438.                WRITE  (' R = redial now   Esc = stop   C = change delay.');
  439.  
  440.                Rchar  := ' ';
  441.                PTimer := MDelay;
  442.                OTimer := PTimer;
  443.  
  444.                REPEAT
  445.  
  446.                   IF PTimer <> OTimer THEN
  447.                      BEGIN
  448.                         GoToXY( 26 , YPos );
  449.                         WRITE( TRUNC( PTimer ) );
  450.                         ClrEol;
  451.                         OTimer := PTimer;
  452.                      END;
  453.  
  454.                   IF KeyPressed THEN
  455.                      BEGIN
  456.  
  457.                         READ( Kbd , Rchar );
  458.  
  459.                         IF UpCase( Rchar ) = 'C' THEN
  460.                            BEGIN
  461.                               GotoXY( 1 , 3 );
  462.                               WRITE  (' Enter new delay: ');
  463.                               ClrEol;
  464.                                  (*$I-*)
  465.                               READLN( MDNew );
  466.                                  (*$I+*)
  467.                               IF Int24Result = 0 THEN
  468.                                  MDelay := MDNew;
  469.                               GoToXY( 1 , 3 );
  470.                               ClrEol;
  471.                            END
  472.                         ELSE IF ( Rchar = CHR( ESC ) ) THEN
  473.                            Rchar := 'X';
  474.  
  475.                      END;
  476.  
  477.                   DTimer := TimeDiff( RTimer , TimeOfDay );
  478.  
  479.                   PTimer := MDelay - DTimer;
  480.                   IF PTimer <= 0.0 THEN
  481.                      PTimer := 0.0;
  482.  
  483.                UNTIL ( DTimer > MDelay ) OR
  484.                      ( UpCase( Rchar ) IN ['R','X'] );
  485.  
  486.                Done := ( UpCase(Rchar) = 'X' );
  487.  
  488.                Restore_Screen( Local_Save_5 );
  489.                Reset_Global_Colors;
  490.  
  491.             END (* NOT Done *)
  492.          ELSE
  493.             BEGIN
  494.  
  495.                Save_Screen( Local_Save_5 );
  496.                Draw_Menu_Frame( 10, 10, 60, 14, Menu_Frame_Color,
  497.                                 Menu_Text_Color + Blink, '' );
  498.  
  499.                WRITELN('Connection established!!');
  500.                WRITE  ('Hit any key to continue');
  501.  
  502.                REPEAT
  503.                   Menu_Beep;
  504.                   DELAY( 3 * Tenth_Of_A_Second_Delay );
  505.                UNTIL( KeyPressed );
  506.  
  507.                READ( Kbd , RChar );
  508.                IF ( RChar = CHR( ESC ) ) AND KeyPressed THEN
  509.                   READ( Kbd, RChar );
  510.  
  511.                Restore_Screen( Local_Save_5 );
  512.                Reset_Global_Colors;
  513.  
  514.             END;
  515.  
  516.       END (* NOT Done *);
  517.  
  518. END   (* Redial_A_Number *);
  519.  
  520. (*------------------------- PIBDIALER --------------------------------*)
  521.  
  522. BEGIN (* PibDialer *)
  523.                                    (* Open phone file for later use *)
  524.  
  525.    ASSIGN( Phone_File, Home_Dir + 'PIBTERM.FON' );
  526.         (*$I-*)
  527.    RESET( Phone_File );
  528.         (*$I+*)
  529.                                    (* Determine if dial or redial   *)
  530.    CASE ReDial OF
  531.  
  532.       FALSE:  REPEAT
  533.                  Dial_A_Number( FALSE , Quit );
  534.                  Quit := Quit OR Script_File_Mode;
  535.                  IF ( ReDial AND ( NOT Quit ) ) THEN
  536.                     BEGIN
  537.                        ReDial_A_Number;
  538.                        Redial := FALSE;
  539.                     END;
  540.               UNTIL ( Async_Carrier_Detect OR Quit );
  541.  
  542.       TRUE:   BEGIN
  543.                  IF Phone_Number = '' THEN
  544.                     Dial_A_Number( FALSE , Quit );
  545.                  ReDial_A_Number;
  546.               END;
  547.  
  548.    END (* CASE *);
  549.                                    (* Close phone file when done *)
  550.       (*$I-*)
  551.    CLOSE( Phone_File );
  552.       (*$I+*)
  553.                                    (* Reset timer if connection made *)
  554.    IF Async_Carrier_Detect THEN
  555.       Dialing_Start_Time := TimeOfDay;
  556.  
  557. END   (* PibDialer *);
  558.